home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / EDITUSR2.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  8KB  |  235 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  4-14-88 3:08 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit EditUsr2;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, TAccess, Core1,
  19.   Core2, TPSTRING, MsgMisc;
  20.   
  21.   
  22. procedure validate_user(ed_fn : FirstName; ed_ln : LastName);
  23.  
  24. procedure delete_user;
  25.  
  26.  
  27.   {==========================================================================}
  28.   
  29.   
  30. Implementation
  31.  
  32.  
  33.   procedure validate_user(ed_fn : FirstName; ed_ln : LastName);
  34.     { Change user access time and level to 'validated' status }
  35.     
  36.   var
  37.     temp_user_loc   : LongInt;
  38.     key             : StrName;
  39.     temp_user_rec   : user_list;
  40.     
  41.   begin
  42.     if ((not remote_copy) and remote_online) then
  43.       begin
  44.         if ask('Validate '+user_rec.fn+' '+user_rec.ln, 'Y') then
  45.           begin
  46.             user_rec.access := val_acc;
  47.             user_rec.limit := val_time;
  48.             user_rec.Flags := 0;
  49.             WriteLn(Com, user_rec.fn, ' ', user_rec.ln, ' validated.')
  50.           end;
  51.       end
  52.     else
  53.       begin
  54.         OK := True;
  55.         SetSect(HomName);
  56.         if ed_fn = '' then
  57.           begin
  58.             ed_fn := trim(prompt('First Name', len_fn, 'ESN'));
  59.             if ed_fn <> '' then
  60.               ed_ln := trim(prompt('Last Name', len_ln, 'ESN'));
  61.             if (ed_fn = '') or (ed_ln = '') then
  62.               OK := False;
  63.           end;
  64.         if OK then
  65.           begin
  66.             key := pad(ed_ln, len_ln)+pad(ed_fn, len_fn);
  67.             FindKey(IdxF, temp_user_loc, key);
  68.           end;
  69.         if OK then
  70.           GetRec(DatF, temp_user_loc, temp_user_rec)
  71.         else
  72.           WriteLn(Com, 'Name not found.');
  73.         if OK then
  74.           begin
  75.             if (temp_user_rec.access < user_rec.access) and
  76.             (ask('Validate '+temp_user_rec.fn+' '+temp_user_rec.ln, 'Y')) then
  77.               begin
  78.                 temp_user_rec.access := val_acc;
  79.                 temp_user_rec.limit := val_time;
  80.                 temp_user_rec.Flags := 0;
  81.                 PutRec(DatF, temp_user_loc, temp_user_rec);
  82.                 WriteLn(Com, temp_user_rec.fn, ' ', temp_user_rec.ln, ' validated.')
  83.               end;
  84.           end;
  85.       end;
  86.   end;
  87.   
  88.   
  89.   procedure delete_user;
  90.     { Delete user from file }
  91.     
  92.   var
  93.     i               : Integer;
  94.     temp_user_loc   : LongInt;
  95.     del_fn          : FirstName;
  96.     del_ln          : LastName;
  97.     key             : StrName;
  98.     temp_user_rec   : user_list;
  99.     This            : MesgPtr;
  100.     err             : Boolean;
  101.     
  102.   begin
  103.     err := False;
  104.     OK := True;
  105.     SetSect(HomName);
  106.     del_fn := trim(prompt('First Name', len_fn, 'ESN'));
  107.     if del_fn <> '' then
  108.       del_ln := trim(prompt('Last Name', len_ln, 'ESN'));
  109.     if (del_fn = '') or (del_ln = '') then
  110.       OK := False;
  111.     if OK then
  112.       begin
  113.         WriteLn(Com);
  114.         key := pad(del_ln, len_ln)+pad(del_fn, len_fn);
  115.         SearchKey(IdxF, temp_user_loc, key);
  116.       end
  117.     else
  118.       temp_user_loc := 0;
  119.     if OK and (temp_user_loc <= FileLen(DatF)) then
  120.       begin
  121.         GetRec(DatF, temp_user_loc, temp_user_rec);
  122.         WriteLn(Com, 'Found User: ', temp_user_rec.fn, ' ', temp_user_rec.ln);
  123.         WriteLn(Com);
  124.         if temp_user_rec.access < user_rec.access then
  125.           if ask('Delete', 'N') then
  126.             begin
  127.               DeleteKey(IdxF, temp_user_loc, key);
  128.               if OK then
  129.                 begin
  130.                   DeleteRec(DatF, temp_user_loc);
  131.                   WriteLn(Com);
  132.                   WriteLn(Com, 'Revising message summary file.');
  133.                   for i := 1 to Pred(FileSize(summ_file)) do
  134.                     begin         { Delete messages pertaining to user }
  135.                       {$I-}
  136.                       Seek(summ_file, i); {$I+}
  137.                       err := (IoResult <> 0);
  138.                       {$I-}
  139.                       Read(summ_file, summ_rec); {$I+}
  140.                       err := (IoResult <> 0);
  141.                       if (((summ_rec.user_to = temp_user_loc) or (summ_rec.user_from =
  142.                         temp_user_loc))) and
  143.                       (not err) then
  144.                         begin
  145.                           if summ_rec.user_to = temp_user_loc then
  146.                             summ_rec.user_to := -1;
  147.                           if summ_rec.user_from = temp_user_loc then
  148.                             summ_rec.user_from := -1;
  149.                           This := MesgBase;
  150.                           while (This <> nil) and (This^.MesgNo <> summ_rec.num) do
  151.                             This := This^.next;
  152.                           if This^.MesgNo = summ_rec.num then
  153.                             begin
  154.                               MesgCurr := This;
  155.                               mesg_delete;
  156.                             end;
  157.                         end;
  158.                     end;
  159.                   if err then
  160.                     begin
  161.                       log(10, 'Del User');
  162.                       log(10, 'Msg File');
  163.                     end;
  164.                   {now clear newin file references}
  165.                   WriteLn(Com, 'Revising Newin file.');
  166.                   {$I-}
  167.                   Seek(nwin_file, 0); {$I+}
  168.                   err := (IoResult <> 0);
  169.                   while (not EoF(nwin_file)) and (not err) do
  170.                     begin
  171.                       {$I-}
  172.                       Read(nwin_file, nwin_rec); {$I+}
  173.                       err := (IoResult <> 0);
  174.                       if (not err) then
  175.                         begin
  176.                           if nwin_rec.user = temp_user_loc then
  177.                             begin
  178.                               nwin_rec.user := 0;
  179.                               Seek(nwin_file, Pred(FilePos(nwin_file)));
  180.                               Write(nwin_file, nwin_rec);
  181.                             end;
  182.                         end;
  183.                     end;
  184.                   if err then
  185.                     begin
  186.                       log(10, 'Del User');
  187.                       log(10, 'Newin File');
  188.                     end;
  189.                   {now finally, the log file}
  190.                   if FileSize(logr_file) > 1 then
  191.                     begin
  192.                       WriteLn(Com, 'Revising the Log file.');
  193.                       {$I-}
  194.                       Seek(logr_file, 1); {$I+}
  195.                       err := (IoResult <> 0);
  196.                       while (not EoF(logr_file)) and (not err) do
  197.                         begin
  198.                           {$I-}
  199.                           Read(logr_file, logr_rec); {$I+}
  200.                           err := (IoResult <> 0);
  201.                           if (not err) then
  202.                             begin
  203.                               if logr_rec.user = temp_user_loc then
  204.                                 begin
  205.                                   logr_rec.user := 0;
  206.                                   Seek(logr_file, Pred(FilePos(logr_file)));
  207.                                   Write(logr_file, logr_rec);
  208.                                   FlushAny(logr_file);
  209.                                 end;
  210.                             end;
  211.                         end;
  212.                     end;          {revising log file}
  213.                   if err then
  214.                     begin
  215.                       log(10, 'Del User');
  216.                       log(10, 'Log File');
  217.                     end;
  218.                   if (not err) and OK then
  219.                     WriteLn(Com, key, ' deleted.');
  220.                   WriteLn(Com);
  221.                 end;              {OK - revising files}
  222.             end;                  { wants to delete}
  223.       end                         {key found}
  224.     else if temp_user_loc > FileLen(DatF) then
  225.       begin
  226.         WriteLn(Com, 'Bad User Number - can not use.');
  227.         log(10, 'delete user');
  228.         log(10, 'User Number');
  229.       end;
  230.   end;                            {delete user}
  231.   
  232.   
  233. end.                              { OF EDITUSR2 }
  234. 
  235.